home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 26 / Cream of the Crop 26.iso / os2 / octa209s.zip / octave-2.09 / libcruft / ranlib / tstbot.for < prev    next >
Text File  |  1996-07-19  |  3KB  |  95 lines
  1.       PROGRAM tstbot
  2. C**********************************************************************
  3. C
  4. C     A test program for the bottom level routines
  5. C
  6. C**********************************************************************
  7. C     Set up the random number generator
  8. C     .. Local Scalars ..
  9.       INTEGER ians,iblock,igen,iseed1,iseed2,itmp,ix,ixgen,nbad
  10. C     ..
  11. C     .. Local Arrays ..
  12.       INTEGER answer(10000),genlst(5)
  13. C     ..
  14. C     .. External Functions ..
  15.       INTEGER ignlgi
  16.       EXTERNAL ignlgi
  17. C     ..
  18. C     .. External Subroutines ..
  19.       EXTERNAL getsd,initgn,setall,setcgn
  20. C     ..
  21. C     .. Data statements ..
  22.       DATA genlst/1,5,10,20,32/
  23. C     ..
  24. C     .. Executable Statements ..
  25.       nbad = 0
  26.       WRITE (*,9000)
  27.  
  28.  9000 FORMAT (' For five virual generators of the 32'/
  29.      +       ' This test generates 10000 numbers then resets the block'/
  30.      +       '      and does it again'/
  31.      +       ' Any disagreements are reported -- there should be none'/)
  32. C
  33. C     Set up Generators
  34. C
  35.       CALL setall(12345,54321)
  36. C
  37. C     For a selected set of generators
  38. C
  39.       DO 60,ixgen = 1,5
  40.           igen = genlst(ixgen)
  41.           CALL setcgn(igen)
  42.           WRITE (*,*) ' Testing generator ',igen
  43. C
  44. C     Use 10 blocks
  45. C
  46.           CALL initgn(-1)
  47.           CALL getsd(iseed1,iseed2)
  48.           DO 20,iblock = 1,10
  49. C
  50. C     Generate 1000 numbers
  51. C
  52.               DO 10,ians = 1,1000
  53.                   ix = ians + (iblock-1)*1000
  54.                   answer(ix) = ignlgi()
  55.    10         CONTINUE
  56.               CALL initgn(+1)
  57.    20     CONTINUE
  58.           CALL initgn(-1)
  59. C
  60. C     Do it again and compare answers
  61. C
  62.           CALL getsd(iseed1,iseed2)
  63. C
  64. C     Use 10 blocks
  65. C
  66.           DO 50,iblock = 1,10
  67. C
  68. C     Generate 1000 numbers
  69. C
  70.               DO 40,ians = 1,1000
  71.                   ix = ians + (iblock-1)*1000
  72. C      ANSWER( IX ) = IGNLGI()
  73.                   itmp = ignlgi()
  74.                   IF (.NOT. (itmp.NE.answer(ix))) GO TO 30
  75.                   WRITE (*,9010) iblock,ians,ix,answer(ix),itmp
  76.  
  77.  9010             FORMAT (' Disagreement on regeneration of numbers'/
  78.      +                   ' Block ',I2,' N within Block ',I2,
  79.      +                   ' Index in answer ',I5/
  80.      +                   ' Originally Generated ',I10,' Regenerated ',
  81.      +                   I10)
  82.  
  83.                   nbad = nbad + 1
  84.                   IF (nbad.GT.10) STOP ' More than 10 mismatches'
  85.    30             CONTINUE
  86.    40         CONTINUE
  87.               CALL initgn(+1)
  88.    50     CONTINUE
  89.           WRITE (*,*) ' Finished testing generator ',igen
  90.           WRITE (*,*) ' Test completed successfully'
  91.    60 CONTINUE
  92.       STOP
  93.  
  94.       END
  95.